home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / 3D-gadgets.st next >
Text File  |  1993-07-24  |  14KB  |  457 lines
  1. "    NAME        3D-gadgets
  2.     AUTHOR        pieter@prls.uucp
  3.     FUNCTION Assorted 3d-style user interface gadgets
  4.     ST-VERSIONS    ?
  5.     PREREQUISITES     
  6.     CONFLICTS    lots
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE    8 Dec 89
  10. SUMMARY     Changes system classes to have 3-D effects including:
  11. - Switches in 3D (similar to switch3d)
  12. - Titles in 3D
  13. - Scrollbars in 3D
  14. - View borders in 3D (if border is thick enough)
  15. "!
  16. "
  17. From: pieter@prls.UUCP (Pieter van der Meulen)
  18. Newsgroups: comp.lang.smalltalk
  19. Subject: Smalltalk 3D interface
  20. Message-ID: <29033@prls.UUCP>
  21. Date: 8 Dec 89 23:28:15 GMT
  22. Organization: Philips Res. Labs, Sunnyvale, CA
  23.  
  24. Several times it has been noted that there are too litle postings with
  25. sources in this newsgroup, but it is changing for the better:
  26.  
  27. I have had several positive responses from people about the 3D switches,
  28. but (unfortunately) it did not spawn new postings on other 3D enhancements.
  29. So, I decided to create a more complete set of 3D changes and they are
  30. listed below, Pieter.
  31.  
  32.  
  33. Yes, these are SYSTEM CHANGES, no scruples this time. If you do
  34. not like to change system classes (understandable), do NOT file this in.
  35. If you did file this in, open a LARGE new Browser to get a good impression.
  36.  
  37. The changes include:
  38. - Switches in 3D (similar to the previous posting)
  39. - Titles in 3D
  40. - Scrollbars in 3D
  41. - View borders in 3D (if border is thick enough)
  42.  
  43. Note:
  44. - (sub-)view borders will not display in 3D unless they are thick enough (>5).
  45.   Only a few system windows will have 3D borders (see first method below).
  46.   If you want other system windows to have 3D borders, you have to search
  47.   for the senders of <borderWidth:>, and YOU may make the changes.
  48. - try thick sub-view borders for the Browser:
  49.   modify all methods in the protocol <BrowserView|subview creation>
  50.   so that <borderWidth: 1> will be <borderWidth: 6>.
  51. - you do not need to give SwitchViews thick borders, because the <clearInside>
  52.   already takes care of that.
  53. - you could also modify PopUpMenus (use Quadrangle3D instead of Quadrangle),
  54.   but that would be (too) much system hacking, so YOU may try that yourself.
  55. - the 3D effects would be a lot nicer if we had true gray-scales....
  56. - see the <Quadrangle3D|display3Drect:on:clipRect:> method-comments if your
  57.   display is in inverse video.
  58. - your <old> windows may look a little funny, because they were
  59.   created with plain Quadrangles.
  60. - the changes are for Smalltalk-80 V2.3, but it will probably also work for
  61.   other versions.
  62.  
  63. I do not claim this is the most elegant solution, and any improvements are
  64. welcome. Have fun,
  65.  
  66.     Pieter S. van der Meulen.
  67.  
  68. DISCLAIMER:
  69.    I take no responsibility whatsoever for the condition of this software.
  70.    Unrestricted use is hereby granted as long as this header remains intact.
  71.  
  72. P.S. van der Meulen, MS 02        prls!!pieter
  73. PRLS, Signetics div. of NAPC      -----------
  74. 811 E.Arques Avenue, Sunnyvale, CA 94088-3409
  75.  
  76.  
  77. "
  78. !
  79.  
  80.  
  81. !StandardSystemView class methodsFor: 'instance creation'!
  82.  
  83. model: aModel label: labelText minimumSize: minimumSize
  84.     "Create windows with a thick border for 3D effects.
  85.     This one will only take care of 3D for some system windows"
  86.  
  87.     | view |
  88.     view _ self new.
  89.     view model: aModel.
  90.     view label: labelText.
  91.     view minimumSize: minimumSize.
  92.     view borderWidth: 6.
  93.     ^view! !
  94.  
  95. !SwitchView methodsFor: 'displaying'!
  96.  
  97. clearInside
  98.     "Create a view with depth effects.
  99.     Written by Pieter S. van der Meulen."
  100.  
  101.     | aRect aBitBlt |
  102.     aRect _ self insetDisplayBox copy.
  103.     aBitBlt _ BitBlt 
  104.         destForm: Display
  105.         sourceForm: nil
  106.         halftoneForm: nil
  107.         combinationRule: Form over
  108.         destOrigin: aRect origin
  109.         sourceOrigin: Display boundingBox origin
  110.         extent: aRect extent
  111.         clipRect: Display boundingBox.
  112.     (label isNil
  113.         ifTrue: [6]
  114.         ifFalse: [((aRect height - label height min:
  115.                 (aRect width - label width)) // 2 - 1) min: 10])
  116.             timesRepeat:
  117.                 [aBitBlt destRect: aRect; mask: Form darkGray; copyBits.
  118.                 aRect corner: aRect corner - (1@1).
  119.                 aBitBlt destRect: aRect; mask: Form lightGray; copyBits.
  120.                 aRect origin: aRect origin + (1@1)].
  121.     aBitBlt destRect: aRect; mask: self insideColor; copyBits!
  122.  
  123. highlight
  124.     "Cause the inset display box (the display box excluding the border, 
  125.     see View|insetDisplayBox) of the receiver to complement."
  126.  
  127.     highlightForm == nil ifFalse: [^highlightForm
  128.             displayOn: Display
  129.             at: self displayBox topLeft
  130.             clippingBox: self insetDisplayBox
  131.             rule: Form reverse
  132.             mask: nil].
  133.     emphasisOn
  134.         ifTrue: [Display reverse: (self insetDisplayBox insetBy: 1)]
  135.         ifFalse: 
  136.             ["Display reverse: (self insetDisplayBox insetBy: 1)."
  137.             Display reverse: (self insetDisplayBox insetBy: 2)]! !
  138.  
  139. !View methodsFor: 'displaying'!
  140.  
  141. displayBorder
  142.     "Display the receiver's border (using the receiver's borderColor)."
  143.  
  144.     self borderWidth = 0
  145.         ifTrue:
  146.             [self insideColor == nil
  147.                 ifFalse: 
  148.                     [Display fill: self displayBox mask: self insideColor]]
  149.         ifFalse:
  150.             [self borderWidth corner x > 5
  151.                 ifTrue: [self display3DBorder]
  152.                 ifFalse:
  153.                     [superView isNil
  154.                         ifTrue:
  155.                             [Display
  156.                                 border: self displayBox
  157.                                 widthRectangle: self borderWidth
  158.                                 mask: borderColor]
  159.                         ifFalse:
  160.                             [Display
  161.                                 border: self displayBox
  162.                                 widthRectangle: self borderWidth
  163.                                 mask: borderColor
  164.                                 clippingBox: superView insetDisplayBox]].
  165.             self insideColor == nil
  166.                 ifFalse: [Display fill: self insetDisplayBox mask: self insideColor]]!
  167.  
  168. display3DBorder
  169.     "Display the receiver's border in 3D.
  170.     Assume the border is thick enough (> 6)."
  171.  
  172.     | aQ3D |
  173.     aQ3D _ Quadrangle3D new.
  174.     aQ3D
  175.         region: self displayBox;
  176.         borderWidth: self borderWidth.
  177.     superView isNil
  178.         ifTrue:    [aQ3D displayOn: Display]
  179.         ifFalse:    [aQ3D displayOn: Display clipRect: superView insetDisplayBox]! !
  180.  
  181. !StandardSystemView methodsFor: 'displaying'!
  182.  
  183. display3Drect: aRect on: aForm clipRect: clipRect
  184.     "Display a Label (Rectangle) on aForm with depth effects.
  185.     Since labels are small, this method is quicker then the similar
  186.     Quadrangle3D method. Flashing effects are hardly noticable.
  187.     Written by Pieter S. van der Meulen."
  188.  
  189.     | aBitBlt shrinkRect |
  190.     (aBitBlt _ BitBlt 
  191.         destForm: aForm
  192.         sourceForm: nil
  193.         halftoneForm: Form black
  194.         combinationRule: Form over
  195.         destOrigin: aRect origin
  196.         sourceOrigin: aForm boundingBox origin
  197.         extent: aRect extent
  198.         clipRect: clipRect) copyBits.
  199.     shrinkRect _ aRect insetBy: 1@1.
  200.     (labelText isNil
  201.         ifTrue: [6]
  202.         ifFalse:
  203.             [((shrinkRect height - labelText height min:
  204.             (shrinkRect width - labelText width)) // 2 - 1) min: 10])
  205.                 timesRepeat:
  206.                     [aBitBlt destRect: shrinkRect; mask: Form darkGray; copyBits.
  207.                     shrinkRect corner: shrinkRect corner - (1@1).
  208.                     aBitBlt destRect: shrinkRect; mask: Form lightGray; copyBits.
  209.                     shrinkRect origin: shrinkRect origin + (1@1)].
  210.     aBitBlt destRect: shrinkRect; mask: Form white; copyBits.
  211.     ^aForm!
  212.  
  213. clear3dLabel
  214.     "Clear the label and add depth effects.
  215.     Written by Pieter S. van der Meulen."
  216.  
  217.     ^self
  218.         display3Drect: self labelDisplayBox
  219.         on: Display
  220.         clipRect: self clippingBox! !
  221.  
  222. !StandardSystemView methodsFor: 'label access'!
  223.  
  224. labelForm
  225.     "Answer with a form that contains the label text."
  226.  
  227.     | form formBox |
  228.     form _ Form extent: labelFrame extent.
  229.     self display3Drect: labelFrame
  230.         on: form
  231.         clipRect: labelFrame.
  232.     labelText isNil
  233.         ifFalse:
  234.             [formBox _ form boundingBox.
  235.             labelText
  236.                 displayOn: form
  237.                 at: (formBox center -
  238.                         (labelText boundingBox center -
  239.                             labelText boundingBox topLeft))
  240.                 clippingBox: formBox].
  241.     ^form! !
  242.  
  243. !StandardSystemView methodsFor: 'icon access'!
  244.  
  245. iconFromLabel
  246.     "Return an icon that looks like my title tab"
  247.  
  248.     | iconForm box |
  249.     iconForm _ Form extent: labelFrame corner + (0 @ 2).
  250.     box _ iconForm computeBoundingBox.
  251.     self display3Drect: box on: iconForm clipRect: box.
  252.     labelText asParagraph
  253.         displayOn: iconForm
  254.         at: (box extent - labelText boundingBox extent) // 2
  255.         clippingBox: box.
  256.     ^Icon new form: iconForm textRect: nil! !
  257.  
  258. !StandardSystemView methodsFor: 'displaying'!
  259.  
  260. displayLabel
  261.  
  262.     self isCollapsed ifTrue: [^self].
  263.     self clear3dLabel.
  264.     labelText isNil
  265.         ifFalse:
  266.             [isLabelComplemented _ false.
  267.             labelText
  268.                 displayOn: Display
  269.                 at: (self labelDisplayBox center -
  270.                         (labelText boundingBox center -
  271.                             labelText boundingBox topLeft))
  272.                 clippingBox: self clippingBox]!
  273.  
  274. displayView
  275.  
  276.     self isCollapsed ifTrue: [^self].
  277.     self clear3dLabel.
  278.     labelText isNil
  279.         ifFalse:
  280.             [isLabelComplemented _ false.
  281.             labelText
  282.                 displayOn: Display
  283.                 at: (self labelDisplayBox center -
  284.                         (labelText boundingBox center -
  285.                             labelText boundingBox topLeft))
  286.                 clippingBox: self clippingBox]! !
  287.  
  288. !StandardSystemView methodsFor: 'label access'!
  289.  
  290. label: aString emphasis: anInteger
  291.     "Set aString to be the receiver's label."
  292.     aString == nil 
  293.         ifTrue: 
  294.             [labelText _ nil.
  295.             labelFrame region: (0 @ 0 extent: 0 @ 0)]
  296.         ifFalse:
  297.             [labelText _ (Text string: aString emphasis: anInteger) asParagraph.
  298.             labelFrame region:
  299.                 (0 @ 0 extent: labelText boundingBox extent + (20 @ 16))].
  300.     iconText isNil & iconView notNil
  301.         ifTrue:
  302.             [iconView text: self label asText].!
  303.  
  304. label: aString 
  305.     "Set aString to be the receiver's label."
  306.     
  307.     self label: aString emphasis: 2! !
  308.  
  309. Quadrangle subclass: #Quadrangle3D
  310.     instanceVariableNames: ''
  311.     classVariableNames: ''
  312.     poolDictionaries: ''
  313.     category: 'Graphics-Primitives'!
  314. Quadrangle3D comment:
  315. 'I am used by scrollbars to create 3D effects.
  316. Written by Pieter S. van der Meulen.'!
  317.  
  318. !Quadrangle3D methodsFor: 'displaying'!
  319.  
  320. display3Drect: aRect on: aForm clipRect: clipRect
  321.     "Change the value of the forward parameter if you want scrollbars
  322.     to go the other way (inward or outward). May be usefull if you
  323.     work in inverse video, and want it to stll come outward.
  324.     Written by Pieter S. van der Meulen."
  325.  
  326.     ^self display3Drect: aRect on: aForm clipRect: clipRect forward: true!
  327.  
  328. display3Drect: aRect on: aForm clipRect: clipRect forward: aBoolean
  329.     "Display a Rectangle on aForm with depth effects.
  330.     If aBoolean is true, let the quadrangle come outward.
  331.     Written by Pieter S. van der Meulen."
  332.  
  333.     | aBitBlt m1 m2 sox soy scx scy |
  334.     sox _ aRect origin x. soy _ aRect origin y.
  335.     scx _ aRect corner x. scy _ aRect corner y.
  336.     (aBitBlt _ BitBlt 
  337.         destForm: aForm
  338.         sourceForm: nil
  339.         halftoneForm: Form black
  340.         combinationRule: Form over
  341.         destOrigin: sox@(scy -1)
  342.         sourceOrigin: aForm boundingBox origin
  343.         extent: (scx - sox) @ 1
  344.         clipRect: clipRect) copyBits.
  345.     aBitBlt destRect: ((scx - 1)@soy corner: scx@scy); copyBits.
  346.     scx _ scx -1. scy _ scy -1.
  347.     aBitBlt destRect: (sox@soy corner: scx @ (soy + 1)); copyBits.
  348.     aBitBlt destRect: (sox@soy corner: (sox + 1) @ scy); copyBits.
  349.     sox _ sox +1. soy _ soy +1.
  350.     aBoolean
  351.         ifTrue: [m1 _ Form darkGray. m2 _ Form lightGray]
  352.         ifFalse: [m2 _ Form darkGray. m1 _ Form lightGray].
  353.     (borderWidth isNil
  354.         ifTrue: [(aRect width min: aRect height) // 2 - 2]
  355.         ifFalse: [borderWidth isInteger
  356.                 ifTrue: [borderWidth]
  357.                 ifFalse: [borderWidth corner x max: borderWidth corner y]])
  358.             timesRepeat:
  359.                 [aBitBlt destRect: (sox@(scy -1) corner: scx@scy); mask: m1; copyBits.
  360.                 aBitBlt destRect: ((scx - 1)@soy corner: scx@scy); copyBits.
  361.                 scx _ scx -1. scy _ scy -1.
  362.                 aBitBlt destRect: (sox@soy corner: scx @ (soy + 1)); mask: m2; copyBits.
  363.                 aBitBlt destRect: (sox@soy corner: (sox + 1) @ scy); copyBits.
  364.                 sox _ sox +1. soy _ soy +1].
  365.     aBitBlt
  366.         destRect: (sox@soy corner: scx@scy);
  367.         mask: (aBoolean ifTrue: [Form white] ifFalse: [Form black]);
  368.         copyBits.
  369.     ^aForm!
  370.  
  371. displayOn: aDisplayMedium
  372.     "Display the border and insideRegion of the receiver."
  373.  
  374.     self
  375.         display3Drect: self region
  376.         on: aDisplayMedium
  377.         clipRect: aDisplayMedium boundingBox!
  378.  
  379. displayOn: aDisplayMedium clipRect: clipRect
  380.     "Display the border and insideRegion of the receiver."
  381.  
  382.     self display3Drect: self region on: aDisplayMedium clipRect: clipRect!
  383.  
  384. displayOn: aDisplayMedium transformation: aWindowingTransformation clippingBox: aRectangle 
  385.     "Display the border and region of the reciever so that it is scaled and translated
  386.     with respect to aWindowingTransformation.  The displayed information should
  387.     be clipped so that only information with the area determined by aRectangle
  388.     is displayed."
  389.  
  390.     self
  391.         display3Drect: self region
  392.         on: aDisplayMedium
  393.         clipRect: ((aWindowingTransformation applyTo: self)
  394.         intersect: aRectangle)! !
  395.  
  396.  
  397. !TextEditor methodsFor: 'marker adjustment'!
  398.  
  399. computeMarkerRegion
  400.     "Answer the rectangular area in which the gray area of the scroll bar
  401.     should be displayed."
  402.  
  403.     paragraph textSize = 0
  404.         ifTrue:    
  405.             [^0@0 extent: 16 @ scrollBar inside height]
  406.         ifFalse:    
  407.             [^0@0 extent: 16 @ 
  408.                 ((((paragraph nextChar - (paragraph lines at: 1)) asFloat 
  409.                         / (paragraph textSize max: 1) asFloat 
  410.                             * scrollBar inside height asFloat) rounded     
  411.                         min: scrollBar inside height) max: 10)]! !
  412.  
  413. !ParagraphEditor methodsFor: 'marker adjustment'!
  414.  
  415. computeMarkerRegion
  416.     paragraph compositionRectangle height = 0
  417.         ifTrue:    [^0@0 extent: 16 @ scrollBar inside height]
  418.         ifFalse:    [^0@0 extent:
  419.                     16 @ ((paragraph clippingRectangle height asFloat /
  420.                             self scrollRectangleHeight * scrollBar inside height) rounded
  421.                             min: scrollBar inside height)]! !
  422.  
  423. !ListController methodsFor: 'marker adjustment'!
  424.  
  425. computeMarkerRegion
  426.     | viewList |
  427.     viewList _ view list.
  428.     ^ 0@0 extent: 16@
  429.             ((viewList clippingRectangle height asFloat /
  430.                         viewList compositionRectangle height *
  431.                             scrollBar inside height)
  432.                     rounded min: scrollBar inside height)! !
  433.  
  434. !ScrollController methodsFor: 'marker adjustment'!
  435.  
  436. computeMarkerRegion
  437.     "Answer the rectangular area in which the gray area of the scroll bar
  438.     should be displayed."
  439.  
  440.     ^0@0 extent: 16 @
  441.             ((view window height asFloat /
  442.                         view boundingBox height *
  443.                             scrollBar inside height)
  444.                  rounded min: scrollBar inside height)! !
  445.  
  446. !ScrollController methodsFor: 'initialize-release'!
  447.  
  448. initialize
  449.     super initialize.
  450.     scrollBar _ Quadrangle new.
  451.     scrollBar insideColor: Form veryLightGray.
  452.     scrollBar borderWidthLeft: 2 right: 0 top: 2 bottom: 2.
  453.     marker _ Quadrangle3D new.
  454.     marker borderWidth: nil
  455.     "marker insideColor: Form gray"! !
  456.  
  457.